Atari Mega Archive 1/Atari Mega Archive - Volume 1.iso/language/forth_83.zoo/strings.scr

Text File | 1992-04-07 | 12KB | 1 lines

\\                      *** Strings ***                13oct86we                                                                Dieses File enthält einige Grundworte zur Stringverarbeitung,   vor allem ein  SEARCH  für den Editor. Ebenfalls sind Worte     zur Umwandlung von counted Strings (Forth) in 0-terminated      Strings, wie sie z.B. vom Betriebssystem oft benutzt werden,    vorhanden.                                                                                                                      Beim SEARCH entscheidet die Variable  CAPS  , ob Groß- und      Kleinschreibung unterschieden wird oder nicht. Ist  CAPS  ON,   so werden große und kleine Buchstaben gefunden, die Suche dau-  ert allerdings länger.                                                                                                          c>0"  wandelt einen String mit führendem Countbyte in einen     mit 0 abgschlossenen, wie er vom Betriebssystem oft gebraucht   wird. 0>c" arbeitet umgekehrt.                                  \ String Functions Loadscreen                          25may86we                                                                1 4 +thru                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       \ -text                                                13oct86we                                                                Variable caps   caps off                                                                                                        Code -text   ( addr0 len addr1 -- n )                              SP )+ D6 move  D6 reg) A1 lea                                   SP )+ D0 move  0= IF  SP ) clr  Next  THEN  1 D0 subq           SP )+ D6 move  D6 reg) A0 lea                                Label comp                                                         .b A0 )+ A1 )+ cmpm  comp  D0 dbne                              .w D0 clr  .b A0 -) D0 move  A1 -) D0 sub   .w D0 ext              D0 SP -) move   Next end-code                                                                                             Label >upper   ( D3 -> D3 )     .b Ascii a D3 cmpi                 >= IF  Ascii z D3 cmpi  <= IF  bl D3 subi  THEN  THEN  rts                                                                   \ -capstext compare                                    13oct86we                                                                | Code -capstext   ( addr0 len addr1 -- n )                        SP )+ D6 move  D6 reg) A1 lea                                   SP )+ D0 move  0= IF  SP ) clr  Next  THEN  1 D0 subq           SP )+ D6 move  D6 reg) A0 lea                                Label capscomp                                                     .b A0 )+ D3 move  >upper bsr  D3 D1 move                           A1 )+ D3 move  >upper bsr  D3 D2 move                          D1 D2 cmp  capscomp D0 dbne   .w D1 clr                       .b A0 -) D3 move  >upper bsr  D3 D1 move                           A1 -) D3 move  >upper bsr  D3 D2 move                        .b D2 D1 sub  .w D1 SP -) move   Next end-code                                                                               : compare   ( addr0 len addr1 -- n )                               caps @ IF  -capstext  ELSE  -text  THEN ;                    \ search delete insert                                 10aug86we                                                                : search   ( text textlen buf buflen  -- offset flag )             over >r  2 pick -  3 pick c@ >r                                 BEGIN  caps @  0= IF  r@ scan  THEN  ?dup                       WHILE  >r >r  2dup r@  compare                                         0= IF  2drop r> rdrop rdrop r> -  true exit  THEN        r> r>  1 /string   REPEAT   -rot 2drop  rdrop  r> - false ;                                                                  : delete   ( buffer size count -- )                                over min >r  r@ - ( left over )  dup 0>                         IF  2dup swap dup  r@ +  -rot  swap  cmove  THEN               + r> bl fill ;                                                                                                                : insert   ( string length buffer size -- )                        rot over min >r  r@ - over dup r@ +  rot cmove>  r> cmove ;  \ String operators                                     13oct86we                                                                Variable $sum                   \ pointer to stringsum          : $add      ( addr len -- )     dup >r                             $sum @ count +  swap  move   $sum @  dup c@  r> +  swap c! ;                                                                 : c>0"   ( addr -- )                                               count >r  dup 1-  under  r@ cmove   r> + 0 swap c!  ;        : 0>c"   ( addr -- )                                               dup >r  true false scan nip negate 1-                           r@ dup 1+ 2 pick cmove>  r> c!  ;                                                                                            : ,0"   Ascii " parse 1+  here over allot  place                        0 c,  align ; restrict                                  : 0"    state @ IF compile (" ,0" compile 1+ exit THEN                             here 1+  ,0" ;        immediate